home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / CMP / LPRM2 / HK / LPR_TERM / GEMX.MOD next >
Encoding:
Modula Implementation  |  1993-12-06  |  5.0 KB  |  160 lines
  1. IMPLEMENTATION MODULE GEMX;
  2.  
  3. (* Rekompiliertes LPR-Originalmodul mit Ergaenzungen fuer Modulterminierung
  4.  * und ACCs.
  5.  *
  6.  * Dieses Modul und die Modulterminierung in LPRTERMINATION werden nur bei
  7.  * gelinkten Programmen ausgefuehrt, nicht jedoch bei Programmen, die unter
  8.  * Kontrolle des Laders laufen!
  9.  *
  10.  * Die Programmierung von ACCs ist nur moeglich, wenn nach dem Linken
  11.  * der RECORD vom Typ ExtInfo direkt hinter dem Programmheader
  12.  * und die BSS-Laenge entsprechend gepatched werden, da der Stackpointer
  13.  * gesetzt werden muss, bevor ein Initialisierungsteil eines Moduls
  14.  * ausgefuehrt wird (bei einem ACC ist SP NICHT initialisiert!), und
  15.  * beim Laden von ACCs automatisch aller Speicher freigegeben wird, sodass
  16.  * Heap und Stack in der BSS beruecksichtigt werden muessen!
  17.  * Es kann entweder der Linker direkt mit FIXLINK.TOS gepatched werden,
  18.  * sodass keine weiteren Aenderungen an den Programmdateien notwendig
  19.  * sind, oder mit FIXPRG.TOS die einzelne Programmdatei. Letzteres kann
  20.  * auch erforderlich sein, wenn andere Werte fuer Stack- und Heapgroesse
  21.  * benoetigt werden.
  22.  *
  23.  * Dateioffset:  Code:      Befehl:
  24.  * $A                       DC.L <BssLen> := <heapSize> + <stackSize>
  25.  *
  26.  * $1C           6000 000A  bra    tstacc
  27.  * $20           xxxx xxxx  DC.L <heapSize>
  28.  * $24           xxxx xxxx  DC.L <stackSize>
  29.  * $28   tstacc: B0FC 0000  cmpa.w #0,A0       ; ACC ?
  30.  * $2C           670A       beq.s  init        ; B: nein, wie gehabt
  31.  * $2E           4FE8 0100  lea    256(A0),SP  ; vorl. Stack in Kommandozeile
  32.  * $32           6004       bra.s  init
  33.  * $34           xxxx xxxx  DC.L <modBase>
  34.  * $38     init: ....
  35.  *
  36.  * Falls die fuer den HALT-Befehl definierte Routine das Programm nicht
  37.  * beendet (die Standardroutine gibt bei gelinkten Programmen nur eine
  38.  * Meldung), wird das Programm nach Ausfuehren der Terminierungsroutinen
  39.  * beendet.
  40.  *
  41.  * 27-Nov-93, Holger Kleinschmidt
  42.  *)
  43.  
  44. FROM System IMPORT
  45. (* TYPE *) HaltProc,
  46. (* VAR  *) HALTX0;
  47.  
  48. FROM SYSTEM IMPORT
  49. (* TYPE *) ADDRESS,
  50. (* PROC *) VAL, REG, SETREG, INLINE;
  51.  
  52. FROM LPRTERMINATION IMPORT
  53. (* VAR  *) BasePageP,
  54. (* PROC *) FINALIZE, IsAPP;
  55.  
  56. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  57.  
  58. CONST
  59.   MINFREE = 16384D; (* mindestens 16kB an TOS zurueckgeben *)
  60.  
  61.   ENSMEM = -39;
  62.  
  63.   PTERM   = 76D;
  64.   MSHRINK = 74D;
  65.  
  66.   d0 = 0;
  67.   sp = 15;
  68.  
  69.  
  70. PROCEDURE Pterm (p1,f:INTEGER); CODE(4E41H);
  71. PROCEDURE Mshrink (p3:LONGINT;p2:ADDRESS;p1,f:CARDINAL); CODE(4E41H);
  72.  
  73. VAR
  74.   start : PROC;
  75.   (* Der Inhalt von 'start' wird vom Linker eingesetzt. Deswegen
  76.    * darf keine weitere Variable im Definitionsmodul deklariert
  77.    * werden, und 'start' muss hier an erster Stelle stehen, damit sich
  78.    * die Adresse der Variable nicht aendert!!
  79.    *)
  80.   pEnd  : LONGINT;
  81.   pLen  : LONGINT;
  82.   Info  : ExtInfoPtr;
  83.   ret   : INTEGER;
  84.   acc   : BOOLEAN;
  85.   halt  : HaltProc;
  86.  
  87. (*===========================================================================*)
  88.  
  89. PROCEDURE PrgHALT;
  90. (* Hier auf keinen Fall HALTX verwenden, sonst Endlosrekursion, da diese
  91.  * Prozedur (die auch bei einem HALT verwendet wird), die Prozedur, die
  92.  * in HALTX0 gespeichert ist, ausfuehrt.
  93.  *)
  94. BEGIN
  95.  halt; (* Alte HALT-Routine ausfuehren *)
  96.  (* Falls die HALT-Routine zurueckkehrt, Programm beenden *)
  97.  FINALIZE(ret);
  98.  Pterm(ret, PTERM);
  99. END PrgHALT;
  100.  
  101. (*===========================================================================*)
  102.  
  103. BEGIN (* GEMX *)
  104.  acc := NOT IsAPP();
  105.  IF acc THEN
  106.    (* Die Basepage wird in 'LPRTERMINATION' ermittelt und hier gesetzt *)
  107.    BasePagePtr := VAL(ADDRESS,BasePageP);
  108.    BasePagePtr^.BssLen := 0D;
  109.    (* Noetig fuer 'Heap' (oder die Initialisierung von 'Heap' muss geaendert
  110.     * werden).
  111.     * In der Hoffnung, dass 'BssLen' weder vom Betriebssystem noch
  112.     * vom Programm mehr benoetigt wird...
  113.     * 'BssLen' == 'heapSize' + stackSize'
  114.     *)
  115.  ELSE
  116.    (* Die Basepage wird hier ermittelt und in 'LPRTERMINATION' gesetzt *)
  117.    INLINE(202FH, 12); (* move.l 12(SP),D0 *)
  118.    BasePagePtr := VAL(ADDRESS,REG(d0));
  119.    BasePageP   := VAL(ADDRESS,BasePagePtr);
  120.  END;
  121.  
  122.  WITH BasePagePtr^ DO
  123.    Info := VAL(ExtInfoPtr,CodeBase);
  124.    pEnd := CodeBase + CodeLen + DataLen;
  125.  END;
  126.  WITH Info^ DO
  127.    (* Anstatt 'BssLen' zu addieren *)
  128.    INC(pEnd, heapSize + stackSize);
  129.  END;
  130.  IF ODD(pEnd) THEN
  131.    INC(pEnd);
  132.  END;
  133.  
  134.  IF acc THEN
  135.    SETREG(sp, pEnd); (* endgueltigen Stack auf Ende der BSS setzen *)
  136.    start; (* kehrt nicht zurueck! *)
  137.  END;
  138.  
  139.  IF pEnd < BasePagePtr^.HighTPA - MINFREE THEN
  140.    (* Programm nur ausfuehren, wenn genuegend Platz *)
  141.    pLen := pEnd - BasePagePtr^.LowTPA;
  142.    SETREG(sp, pEnd); (* Stack setzen *)
  143.  
  144.    Mshrink(pLen, BasePagePtr, 0, MSHRINK);
  145.    INLINE(4FEFH, 12); (* lea 12(SP),SP *)
  146.  
  147.    BasePagePtr^.HighTPA := pEnd;
  148.  
  149.    halt   := HALTX0;  (* Alte HALT-Routine merken *)
  150.    HALTX0 := PrgHALT; (* Neue HALT-Routine installieren *)
  151.  
  152.    start; (* Programm ausfuehren *)
  153.  
  154.    FINALIZE(ret); (* Terminierungsroutinen ausfuehren *)
  155.    Pterm(ret, PTERM);
  156.  ELSE
  157.    Pterm(ENSMEM, PTERM);
  158.  END;
  159. END GEMX.
  160.